// RealPlay Ltd  copyrights.
// This program is Open Source AsIs
// You may use it for all purposes, including commercial
// But!!!
// If you use any part of this code, you must state clearly
// both in your source file and in the Help|about of your program,
// that the origin program or code was built by RealPlay Ltd

// ****************************************************************************/
// *                                                                     */
// * This unit is the dialog for Stretvh & Skew (Ctrl+W) for  "Paint" Program */
// *                                                                     */
// ****************************************************************************/

unit UPStretchSkew;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TFStretchSkew = class(TForm)
    Button1: TButton;
    Button2: TButton;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    EHor: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    EVer: TEdit;
    Label4: TLabel;
    Image1: TImage;
    GroupBox2: TGroupBox;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Image2: TImage;
    ESHor: TEdit;
    ESVer: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FStretchSkew: TFStretchSkew;

implementation

uses UPMain, UPUtil, Math;
{$R *.dfm}

function skewh(bs, bd: TBitmap; deg: integer): boolean;
var
  skfull, sk, w, h: integer;
  tga: real;
begin
  result := false;
  try
    deg := deg mod 90;
    if deg = 90 then
      tga := MaxExtended
    else if deg = -90 then
      tga := MinExtended
    else
      tga := tan(deg * pi / 180);
    if abs(tga) > 10 then
    begin
      MessageDlg('The skew is to big'#13'Change the degrees', mtError, [mbOk],
        0);
      screen.Cursor := crDefault;
      exit;
    end;
    skfull := round(tga * bs.Height);
    bd.Width := bs.Width + abs(skfull);
    bd.Height := bs.Height;
    for h := 0 to bd.Height - 1 do
    begin
      if skfull > 0 then
        sk := skfull - round(skfull * h / bs.Height)
      else
        sk := -round(skfull * h / bs.Height);
      for w := 0 to bs.Width - 1 do
        bd.Canvas.Pixels[w + sk, h] := bs.Canvas.Pixels[w, h];
    end;
  except
    result := false;
  end;
  result := true;
end;

// *****************************************************************
procedure TFStretchSkew.FormCreate(Sender: TObject);
begin
  top := FPaint.top + 60;
  if top + Height + 20 > screen.Height then
    top := screen.Height - Height - 20;
  left := FPaint.left + 20;
  if left < 20 then
    left := 20;
  if left + Width + 20 > screen.Width then
    left := screen.Width - Width - 20;
  FPaint.FWA.ImSelS.ClearSel;
end;

procedure TFStretchSkew.FormShow(Sender: TObject);
begin
  FormCreate(nil);
  EHor.Text := '100';
  EVer.Text := '100';
  ESHor.Text := '0';
  ESVer.Text := '0';
end;

procedure TFStretchSkew.Button1Click(Sender: TObject);
var
  i, v, w, h: integer;
  BTmp: TBitmap;
  tcl: Tcolor;
begin
  //
  with EHor do
    for i := 1 to length(Text) do
      if not(Text[i] in ['0' .. '9']) then
        exit;
  with EVer do
    for i := 1 to length(Text) do
      if not(Text[i] in ['0' .. '9']) then
        exit;
  with ESHor do
    for i := 1 to length(Text) do
      if not(Text[i] in ['0' .. '9', '-']) then
        exit;
  with ESVer do
    for i := 1 to length(Text) do
      if not(Text[i] in ['0' .. '9', '-']) then
        exit;
  BTmp := TBitmap.Create;
  with FPaint.FWA.Im.Picture do
    try
      tcl := bitmap.TransparentColor;
      v := strtoint(EHor.Text);
      if (v <> 100) and (v <> 0) then
        w := (Width * v) div 100
      else
        w := Width;
      v := strtoint(EVer.Text);
      if (v <> 100) and (v <> 0) then
        h := (Height * v) div 100
      else
        h := Height;
      UPUtil.Stretch(bitmap, BTmp, w, h);
      bitmap.Assign(BTmp);
      BTmp.Free;
      BTmp := TBitmap.Create;
      v := strtoint(ESHor.Text);
      if v <> 0 then
        if skewh(bitmap, BTmp, v) then
          bitmap.Assign(BTmp);
      v := strtoint(ESVer.Text);
      if v <> 0 then
      begin
        TurnBitMap(bitmap, false);
        if skewh(bitmap, BTmp, v) then
          bitmap.Assign(BTmp);
        TurnBitMap(bitmap, true);
      end;
    finally
      bitmap.TransparentColor := tcl;
      BTmp.Free;
      with FPaint.FWA do
      begin
        ImPanel.Width := round(Im.Picture.Width / ZoomXr) + IMRightPanel.Width;
        ImPanel.Height := round(Im.Picture.Height / ZoomYr)
          + IMBottomPanel.Height;
        MyStat.changed := true;
      end;
    end;
  close;
end;

procedure TFStretchSkew.Button2Click(Sender: TObject);
begin
  close;
end;

end.
